home *** CD-ROM | disk | FTP | other *** search
/ PC Users 1998 June / Cd Pc Users 9.iso / prog / inst / baslibs / basapi.bas next >
Encoding:
BASIC Source File  |  1996-12-11  |  4.9 KB  |  186 lines

  1. Attribute VB_Name = "basAPI"
  2. Option Explicit
  3.  
  4. ' General API functions.
  5.  
  6. Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
  7.  
  8.  
  9. Private Const HWND_TOPMOST = -1
  10. Private Const SWP_NOACTIVATE = &H10
  11. Private Const SWP_SHOWWINDOW = &H40
  12. Private Const SWP_HIDEWINDOW = &H80
  13. Private Const SWP_NOZORDER = &H4
  14. Private Const SWP_NOMOVE = &H2
  15. Private Const SWP_NOREPOSITION = &H200
  16. Private Const SWP_NOSIZE = &H1
  17.  
  18. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
  19.     ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, _
  20.     ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  21.     
  22. Private Declare Function FindWindow Lib "user32" _
  23.    Alias "FindWindowA" (ByVal lpClassName As String, ByVal _
  24.    lpWindowName As String) As Long
  25.     
  26. Private Declare Function GetForegroundWindow Lib "user32" () As Long
  27.  
  28. Private Declare Function GetParent Lib "user32" _
  29.    (ByVal hwnd As Long) As Long
  30.    
  31. Private Declare Function GetWindowTextLength Lib "user32" _
  32.    Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
  33.    
  34. Private Declare Function GetWindowText Lib "user32" Alias _
  35.    "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, _
  36.    ByVal cch As Long) As Long
  37.  
  38. Private Declare Function GetUserNameA Lib "advapi32.dll" _
  39.    (ByVal lpBuffer As String, nSize As Long) As Long
  40.  
  41. Private TaskBarhWnd As Long
  42.  
  43.  
  44. 'Exit's windows with one of the following results.
  45. '   dwReserved = 0
  46. Private Declare Function ExitWindowsEx Lib "user32" (ByVal _
  47.    uFlags As Long, ByVal dwReserved As Long) As Long
  48.    
  49. Public Const EXIT_LOGOFF = 0
  50. Public Const EXIT_SHUTDOWN = 1
  51. Public Const EXIT_REBOOT = 2
  52.  
  53. Private Declare Function GetComputerNameA Lib "kernel32" _
  54.    (ByVal lpBuffer As String, nSize As Long) As Long
  55.  
  56. ' General API functions. (with no VBasic wrapper)
  57.  
  58. 'Puts the app to sleep for the given number of milliseconds
  59. Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  60.  
  61. Public Sub ExitWindows(ByVal uFlags As Long)
  62.    Call ExitWindowsEx(uFlags, 0)
  63. End Sub
  64.  
  65.  
  66. Public Function GetUserName() As String
  67.    Dim UserName As String * 255
  68.  
  69.    Call GetUserNameA(UserName, 255)
  70.    GetUserName = Left$(UserName, InStr(UserName, Chr$(0)) - 1)
  71. End Function
  72. '
  73. ' Returns the computer's name
  74. '
  75. Public Function GetComputerName() As String
  76.    Dim UserName As String * 255
  77.  
  78.    Call GetComputerNameA(UserName, 255)
  79.    GetComputerName = Left$(UserName, InStr(UserName, Chr$(0)) - 1)
  80. End Function
  81.  
  82. '
  83. ' Returns the title of the active window.
  84. '    if GetParent = true then the parent window is
  85. '                   returned.
  86. '
  87. Public Function GetActiveWindowTitle(ByVal ReturnParent As Boolean) As String
  88.    Dim i As Long
  89.    Dim j As Long
  90.    
  91.    i = GetForegroundWindow
  92.    
  93.    
  94.    If ReturnParent Then
  95.       Do While i <> 0
  96.          j = i
  97.          i = GetParent(i)
  98.       Loop
  99.    
  100.       i = j
  101.    End If
  102.    
  103.    GetActiveWindowTitle = GetWindowTitle(i)
  104. End Function
  105.  
  106. Public Sub HideTaskBar()
  107.     TaskBarhWnd = FindWindow("Shell_traywnd", "")
  108.     If TaskBarhWnd <> 0 Then
  109.        Call SetWindowPos(TaskBarhWnd, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
  110.     End If
  111. End Sub
  112. Public Sub ShowTaskBar()
  113.     If TaskBarhWnd <> 0 Then
  114.        Call SetWindowPos(TaskBarhWnd, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
  115.     End If
  116. End Sub
  117. '
  118. ' Returns the handle of the active window.
  119. '    if GetParent = true then the parent window is
  120. '                   returned.
  121. '
  122. Public Function GetActiveWindow(ByVal ReturnParent As Boolean) As Long
  123.    Dim i As Long
  124.    Dim j As Long
  125.    
  126.    i = GetForegroundWindow
  127.    
  128.    
  129.    If ReturnParent Then
  130.       Do While i <> 0
  131.          j = i
  132.          i = GetParent(i)
  133.       Loop
  134.    
  135.       i = j
  136.    End If
  137.    
  138.    GetActiveWindow = i
  139. End Function
  140.  
  141.  
  142. Public Function GetWindowTitle(ByVal hwnd As Long) As String
  143.    Dim l As Long
  144.    Dim s As String
  145.    
  146.    l = GetWindowTextLength(hwnd)
  147.    s = Space(l + 1)
  148.    
  149.    GetWindowText hwnd, s, l + 1
  150.    
  151.    GetWindowTitle = Left$(s, l)
  152. End Function
  153.  
  154. '
  155. '  Makes a form the top window if top = True.  When top = False it removes
  156. '  this property.
  157. '
  158. Public Sub TopMostForm(f As Form, Top As Boolean)
  159.    If Top Then
  160.       SetWindowPos f.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
  161.    Else
  162.       SetWindowPos f.hwnd, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE
  163.    End If
  164. End Sub
  165.  
  166. '
  167. '  Sleeps for a given number of seconds.
  168. '
  169. Public Sub Pause(ByVal seconds As Single)
  170.    Call Sleep(Int(seconds * 1000#))
  171. End Sub
  172.  
  173. '
  174. '  Generates a standard windows About box.
  175. '
  176. Public Sub AboutBox(frm As Form, Optional copyright As Variant)
  177.    If VarType(copyright) = vbString Then
  178.       Call ShellAbout(frm.hwnd, App.ProductName, copyright, frm.icon)
  179.    Else
  180.       Call ShellAbout(frm.hwnd, App.ProductName, "", frm.icon)
  181.    End If
  182. End Sub
  183.  
  184.  
  185.  
  186.